home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / dired-uu.el.z / dired-uu.el
Encoding:
Text File  |  1998-05-21  |  3.8 KB  |  117 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;
  3. ;; File:          dired-uu.el
  4. ;; Dired Version: #Revision: 7.9 $
  5. ;; RCS:
  6. ;; Description:   Commands for uuencoding/uudecoding marked files.
  7. ;; Author:        Sandy Rutherford <sandy@math.ubc.ca>
  8. ;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. ;;; Requirements and provisions
  12. (provide 'dired-uu)
  13. (require 'dired)
  14.  
  15. (defvar dired-uu-files-to-decode nil)
  16. ;; Fluid var to pass data inside dired-create-files.
  17.  
  18. (defun dired-uucode-file (file ok-flag)
  19.   ;; uuencode or uudecode FILE.
  20.   ;; Don't really support the ok-flag, but needed for compatibility
  21.   (let ((handler (find-file-name-handler file 'dired-uucode-file)))
  22.     (cond (handler
  23.        (funcall handler 'dired-uucode-file file ok-flag))
  24.       ((or (file-symlink-p file) (file-directory-p file))
  25.        nil)
  26.       (t
  27.        (if (assoc file dired-uu-files-to-decode)
  28.            (let ((default-directory (file-name-directory file)))
  29.          (if (dired-check-process
  30.               (concat "Uudecoding " file) shell-file-name "-c"
  31.               (format "uudecode %s" file))
  32.             (signal 'file-error (list "Error uudecoding" file))))
  33.          (let ((nfile (concat file ".uu")))
  34.            (if (dired-check-process
  35.            (concat "Uuencoding " file) shell-file-name "-c"
  36.            (format "uuencode %s %s > %s"
  37.                file (file-name-nondirectory file) nfile))
  38.            (signal 'file-error (list "Error uuencoding" file)))))))))
  39.  
  40. (defun dired-uucode-out-file (file)
  41.   ;; Returns the name of the output file for the uuencoded FILE.
  42.   (let ((buff (get-buffer-create " *dired-check-process output*"))
  43.     (case-fold-search t))
  44.     (save-excursion
  45.       (set-buffer buff)
  46.       (erase-buffer)
  47.       (if (string-equal "18." (substring emacs-version 0 3))
  48.       (call-process "head" file buff nil "-n" "1")
  49.     (insert-file-contents file nil 0 80))
  50.       (goto-char (point-min))
  51.       (if (looking-at "begin [0-9]+ \\([^\n]*\\)\n")
  52.       (expand-file-name
  53.        (buffer-substring (match-beginning 1) (match-end 1))
  54.        (file-name-directory file))
  55.     nil))))
  56.  
  57. (defun dired-do-uucode (&optional arg files to-decode)
  58.   "Uuencode or uudecode marked (or next ARG) files."
  59.   (interactive
  60.    (let* ((dir (dired-current-directory))
  61.       (files (dired-get-marked-files nil current-prefix-arg))
  62.       (arg (prefix-numeric-value current-prefix-arg))
  63.       (total (length files))
  64.       rfiles decoders ofile decode encode hint-p)
  65.      (mapcar
  66.       (function
  67.        (lambda (fn)
  68.      (if (setq ofile (dired-uucode-out-file fn))
  69.          (setq decoders (cons (cons fn ofile) decoders)))))
  70.       files)
  71.      (setq decode (length decoders)
  72.        encode (- total decode)
  73.        hint-p (not (or (zerop decode) (zerop encode))))
  74.      (setq rfiles
  75.        (mapcar
  76.         (function
  77.          (lambda (fn)
  78.            (if hint-p
  79.            (concat
  80.             (if (assoc fn decoders) " [de] " " [en] ")
  81.             (dired-make-relative fn dir t))
  82.          (dired-make-relative fn dir t))))
  83.         files))
  84.      (or (memq 'uuencode dired-no-confirm)
  85.      (dired-mark-pop-up nil 'uuencode rfiles 'y-or-n-p
  86.                 (cond
  87.                  ((null decoders)
  88.                   (if (= encode 1)
  89.                   (format "Uuencode %s? " (car rfiles))
  90.                 (format "Uuencode %d file%s? "
  91.                     encode (dired-plural-s encode))))
  92.                  ((zerop encode)
  93.                   (if (= decode 1)
  94.                   (format "Uudecode %s? " (car rfiles))
  95.                 (format "Uudecode %d file%s? "
  96.                     decode (dired-plural-s decode))))
  97.                  (t
  98.                   (format "Uudecode %d and uuencode %d file%s? "
  99.                       decode encode (dired-plural-s encode)))))
  100.      (setq arg 0))
  101.      (list arg files decoders)))
  102.   (let ((dired-uu-files-to-decode to-decode)
  103.     out-file)
  104.     (if (not (zerop arg))  
  105.     (dired-create-files
  106.      'dired-uucode-file
  107.      "Uuencode or Uudecode"
  108.      files
  109.      (function
  110.       (lambda (fn)
  111.         (if (setq out-file (assoc fn dired-uu-files-to-decode))
  112.         (cdr out-file)
  113.           (concat fn ".uu"))))
  114.      dired-keep-marker-uucode nil t))))
  115.  
  116. ;;; end of dired-uu.el
  117.